O’Hara on GitHub


knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.path = 'figs/',
                      echo = TRUE, message = FALSE, warning = FALSE)

library(raster)
source('https://raw.githubusercontent.com/oharac/src/master/R/common.R')

source(here('common_fxns.R'))

1 Summary

Create taxa-level maps of number of species impacted per cell, per year.

2 Methods

  • Gather species maps by taxonomic group (IUCN comprehensively assessed groups)
  • read in all impact maps for species for all years, flatten to impacted/not for each year
  • add maps together for a taxa-level map for each year of number of impacted species per cell
  • repeat similar process for refugia.

2.1 Match threatened species to taxonomic groups per IUCN

Identify the species included in the impacted list (using the IUCN species IDs of impact map files, from prior scripts!). Join this with the list of mapped species, to identify which taxonomic group the species is in (based on the downloaded IUCN shapefiles). Taxa groups not represented in the impacted species list will be dropped.

impact_map_dir <- file.path(dir_bd_anx, 'spp_impact_rasts')

### identify spp with impact maps
spp_impacted <- list.files(impact_map_dir, recursive = TRUE) %>%
  str_extract('[0-9]+') %>%
  as.integer() %>%
  unique()

### Get inclusion list; drop species with no sensitivities to stressors.
### Also append the class level taxa instead of assessment group taxa
spp_sens <- get_incl_spp() %>%
  filter(!is.na(stressor)) %>%
  left_join(get_spp_taxon(), by = c('iucn_sid', 'assess_gp')) %>%
  mutate(taxon = tolower(rank))

### look for dropped taxonomic groups...
comp_file <- here('_data', sprintf('iucn_comp_assessed_%s.csv', api_version))
spp_comp <- read_csv(comp_file)

taxa_dropped <- spp_comp %>%
  filter(!assess_gp %in% spp_sens$assess_gp) %>%
  .$assess_gp %>% unique()

Taxonomic groups dropped from this analysis - i.e., group does not have any species that fits the “impacted” criteria:

chameleons, cycads, magnolias, fw_caridean_shrimps, fw_crayfish, conifers, surgeonfishes, crocodiles_and_alligators, fw_crabs, cacti, tarpons_and_ladyfishes, sturgeons, lobsters, amphibians

The one vulnerable tarpon species (i.e. not LC, EX, or DD) is not sensitive to any of the stressors and is not mapped, so the whole taxon is dropped from this analysis.

### directories for inputs
spp_impact_map_dir   <- file.path(dir_bd_anx, 'spp_impact_rasts')
spp_range_dir        <- file.path(dir_bd_anx, 'spp_rasts_mol_2020')

### directories for outputs
taxon_impact_map_dir <- file.path(dir_bd_anx, 'taxon_impact_rasts')
### unlink(file.path(taxon_impact_map_dir, 'taxon_impact_birds_*.*'))
### unlink(file.path(taxon_impact_map_dir, '*.*'))

cell_id_rast <- raster(here('_spatial/cell_id_mol.tif'))
ocean_a_rast <- raster(here('_spatial/ocean_area_mol.tif'))

2.2 Loop over taxonomic groups to create taxa-level impact maps

These maps ignore the number of impacts occurring on each species, and count up the number of species impacted by the aggregated stressor group (land-based, ocean, climate, and fishing).

We will calculate unweighted impacts and range-weighted impacts based on protected area inclusion targets from Butchart et al 2015: 1 when range <= 1000 km2, 0.1 when range >= 250000 km2, log-linear interpolation between (no cap at 10 million km2, at this point).

For a given taxon:

  • identify full list of impacted species
  • select a subgroup (~10 spp) to process at a time
    • read in all spp in group
    • flatten all spp impact maps (for impacts > 0, set “impacted” = TRUE)
      • no need to worry about refugia cells at this stage.
    • add all maps for this group: by cell/year per stressor
    • also add priority values for each cell/year per stressor
  • for all subgroups in a taxa, add them up.
get_spp_vec <- function(spp_ids, i, subgp_size) {
  gp_first <- (i - 1) * subgp_size + 1
  gp_last  <- min(i * subgp_size, length(spp_ids))
  spp_id_vec <- spp_ids[gp_first:gp_last]
}

get_spp_impact <- function(spp_id, imp_file) {
  impact_map <- read_csv(imp_file, col_types = 'iii') %>%
    filter(!is.na(year) & !is.na(cell_id)) %>%
    filter(n_impacts > 0 & !is.na(n_impacts)) %>%
    select(cell_id, year) %>%
    mutate(iucn_sid = spp_id)
  return(impact_map)
}

taxon_gps <- spp_sens$taxon %>% unique() %>% sort()

subgp_size <- 24 ### number of spp to process at a time
year_span <- 2003:2013
reload <- FALSE
str_cats <- c('land-based', 'ocean', 'fishing', 'climate', 'all')

### load priorities; if not normalizing, priority is based only on range, so
### easily repeatable and not dependent on the spp set
priority_df <- get_spp_priority() %>%
  filter(iucn_sid %in% spp_sens$iucn_sid)

for(str_cat in str_cats) {
  # str_cat <- str_cats[5]
  
  for(taxon_gp in taxon_gps) {
    ### taxon_gp <- taxon_gps[6]
    
    taxon_map_files <- file.path(taxon_impact_map_dir, 
                                sprintf('taxon_impact_%s_%s_%s.tif',
                                        taxon_gp, year_span, str_cat))
    taxon_priority_map_files <- file.path(taxon_impact_map_dir, 
                                sprintf('taxon_priority_impact_%s_%s_%s.tif',
                                        taxon_gp, year_span, str_cat))
    
    if(any(!file.exists(c(taxon_map_files, taxon_priority_map_files))) | reload) {
      spp_ids_taxa <- spp_sens %>%
        filter(taxon == taxon_gp) %>%
        filter(str_cat == 'all' | category == str_cat) %>%
        .$iucn_sid %>% 
        unique() %>% sort()
      
      n_subgps <- ceiling(length(spp_ids_taxa) / subgp_size)
      message('Processing ', str_cat, ' impacts for ', taxon_gp, 
              ': ', length(spp_ids_taxa), 
              ' species broken into ', n_subgps, ' groups.')
      
      if(length(spp_ids_taxa) == 0) {
        ### uh oh, no species in this taxon affected by this stressor.
        taxon_impacts_df <- data.frame()
      } else {
        ### loop over all spp in this taxon affected by this stressor
        ### initialize a list to store 
        taxon_impacts_list <- vector('list', length = n_subgps)
        for(i in 1:n_subgps) {
          # i <- 1
          message('  processing group ', i)
          spp_id_vec <- get_spp_vec(spp_ids_taxa, i, subgp_size)
          
          impact_maps <- parallel::mclapply(spp_id_vec,
              FUN = function(spp_id) {
                ### spp_id <- spp_id_vec[1]
                imp_file <- file.path(spp_impact_map_dir, 
                                   sprintf('spp_impact_map_%s_%s.csv', spp_id, str_cat))
                imp_map <- get_spp_impact(spp_id, imp_file)
              }, mc.cores = subgp_size) %>%
            bind_rows()
          message('  summarizing group ', i)
          # system.time({
          impacts_gp <- impact_maps %>%
            dt_join(priority_df, by = 'iucn_sid', type = 'left') %>%
            group_by(cell_id, year) %>%
            summarize(priority_sum_spp = sum(priority, na.rm = TRUE),
                      n_spp = n()) %>%
            ungroup()
          # })
          
          taxon_impacts_list[[i]] <- impacts_gp
        } ### end of for loop
      
      taxon_impacts_df <- bind_rows(taxon_impacts_list) %>%
        group_by(cell_id, year) %>%
        summarize(n_spp = sum(n_spp, na.rm = TRUE),
                  priority_sum_spp = sum(priority_sum_spp, na.rm = TRUE)) %>%
        ungroup() %>%
        mutate(taxon = taxon_gp)
      
      } ### end of if statement for zero-length species vector
      
      if(nrow(taxon_impacts_df) == 0) {
        ### either no species in the list, or no impacts for any of the spp
        taxon_impacts_df <- data.frame(cell_id = NA,
                                       year    = NA,
                                       n_spp   = NA,
                                       priority_sum_spp = NA,
                                       taxon   = taxon_gp)
      }
      
      ### write out as count and priority rasters by year
      for(i in seq_along(year_span)) {
        # i <- 1
        taxon_nspp_map_file <- taxon_map_files[i]
        taxon_pr_map_file   <- taxon_priority_map_files[i]
        
        taxon_impact_yr_df <- taxon_impacts_df %>%
          filter(year == year_span[i])
        
        nspp_yr_rast <- map_to_rast(taxon_impact_yr_df, 
                                    cell_val = 'n_spp')
        writeRaster(nspp_yr_rast, taxon_nspp_map_file, overwrite = TRUE)
        
        pr_sum_yr_rast <- map_to_rast(taxon_impact_yr_df,
                                      cell_val = 'priority_sum_spp')
        writeRaster(pr_sum_yr_rast, taxon_pr_map_file, overwrite = TRUE)
        
      }
      
    } else {
      message('Files exist... skipping!')
    }
  }
}

2.3 Animate select taxa impact maps

library(animation)

make_ramp <- function(n, palette, log_out = TRUE) {
  if(log_out) {
    n_even <- ceiling(n)
    n_max <- 10^n_even
    log_steps <- c(1, 2, 5, 10, 20, 50, 100, 200, 500, 1000)
    log_steps <- log_steps[log_steps <= n_max]
    
    breaks <- seq(0, n_even, length.out = 100)
    lblpos <- log10(log_steps)
    labels <- 10^lblpos
    colors <- hcl.colors(length(breaks), palette = palette)
  } else {
    n_even <- round(n + 50, -2)
    breaks <- c(0, seq(.5, n_even, length.out = 100))
    lblpos <- seq(0, n_even, by = 50)
    labels <- lblpos
    colors <- c('grey40', hcl.colors(100, palette = palette))
  }
  
  ### For breaks and colors, add a different color for 
  ### a value of exactly zero
  return(list('colors' = colors,
              'breaks' = breaks,
              'labels' = labels,
              'lblpos' = lblpos))
}

make_gifs <- function(map_stack, filename, layer_names = NULL, log_out = TRUE) {
  if(is.null(layer_names)) layer_names = names(map_stack)

  if(log_out) map_stack <- log10(map_stack)
  
  n <- max(c(maxValue(map_stack), 1), na.rm = TRUE)

  ramp <- make_ramp(n, palette = 'viridis', log_out)
  
  capture.output({
    saveGIF({
      for(i in 1:nlayers(map_stack)){
        plot(map_stack[[i]], 
             col = ramp$colors,
             breaks = ramp$breaks,
             axes = FALSE,
             axis.args = list(at = ramp$lblpos, labels = ramp$labels),
             main = layer_names[i])
      }}, 
      interval = 0.5, movie.name = filename, 
      ani.width = 700, ani.height = 420)
  })
  
  return(invisible(NULL))
}
mapfiles <- list.files(taxon_impact_map_dir, full.names = TRUE)

all_taxa_maps <- data.frame(f = mapfiles) %>%
  mutate(impact = str_replace_all(basename(f), 'taxon.+_[0-9]{4}_|.tif', ''),
         type = ifelse(str_detect(basename(f), 'priority'), 'priority', 'sum'),
         year = str_extract(basename(f), '[0-9]{4}') %>% as.integer(),
         taxon = str_replace_all(basename(f), 'taxon.+impact_|_[0-9].+', ''))

str_cats <- c('fishing', 'land-based', 'ocean', 'climate', 'all')
taxa <- all_taxa_maps$taxon %>% 
  unique()
taxa <- taxa[c(1, 2, 3, 5, 9)]
### Animate the results

for(str_cat in str_cats) {
  # str_cat <- str_cats[3]
  for(t in taxa) {
    # t <- taxa[2]
    gif_file <- here(sprintf('figs/impact_%s_%s.gif', t, str_cat))
    
    if(!file.exists(gif_file) | reload) {
      taxon_map_df <- all_taxa_maps %>%
        filter(taxon == t) %>%
        filter(impact == str_cat) %>%
        filter(type == 'sum')
      rast_files <- taxon_map_df$f
      map_stack <- stack(rast_files)
      
      make_gifs(map_stack, 
                filename = gif_file,
                layer_names = paste(t, str_cat, 'impacts', taxon_map_df$year))
    }
    
    cat(sprintf('![](%s)', gif_file))
  }
}

### Animate the results

for(str_cat in str_cats) {
  # str_cat <- str_cats[3]
  for(t in taxa) {
    # t <- taxa[4]
    gif_file <- here(sprintf('figs/impact_priorities_%s_%s.gif', t, str_cat))
    
    if(!file.exists(gif_file) | reload) {
      taxon_map_df <- all_taxa_maps %>%
        filter(taxon == t) %>%
        filter(impact == str_cat) %>%
        filter(year == 2013)
      rast_files <- taxon_map_df$f
      priority_file <- str_detect(rast_files, 'priority')
      count_rast <- raster(rast_files[!priority_file])
      priority_rast <- raster(rast_files[priority_file])
      ### define rescaling factors
      c_r <- range(values(count_rast), na.rm = TRUE)
      p_r <- range(values(priority_rast), na.rm = TRUE)
      
      if(p_r[2] - p_r[1] == 0) {
        ### just one value; avoid div by zero
        p_rescale <- priority_rast * c_r[1] / p_r[1]
      } else {
        p_rescale <- (priority_rast - p_r[1]) / (p_r[2] - p_r[1])
        p_rescale <- p_rescale * (c_r[2] - c_r[1]) + c_r[1]
      }

      map_stack <- stack(count_rast, p_rescale)
      make_gifs(map_stack, 
                filename = gif_file,
                layer_names = str_replace_all(names(map_stack), 'taxon_|.tif', ''))
    }
    
    cat(sprintf('![](%s)', gif_file))
  }
}